home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / TIPS / MDISPLSH.PAS < prev    next >
Pascal/Delphi Source File  |  1991-10-09  |  2KB  |  79 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Pascal for Windows                     }
  4. {   Tips & Techniques Demo Program               }
  5. {   Copyright (c) 1991 by Borland International  }
  6. {                                                }
  7. {************************************************}
  8.  
  9. program MDISplash;
  10.  
  11. {$R MDISplsh.RES}
  12.  
  13. uses WObjects, WinTypes, WinProcs;
  14.  
  15. type
  16.   TMDIApp = object(TApplication)
  17.     procedure InitMainWindow; virtual;
  18.   end;
  19.  
  20.   PMyMDIWin = ^TMyMDIWin;
  21.   TMyMDIWin = object(TMDIWindow)
  22.     procedure InitClientWindow; virtual;
  23.   end;
  24.  
  25.   PMyMDIClient = ^TMyMDIClient;
  26.   TMyMDIClient = object(TMDIClient)
  27.     procedure WMPaint(var msg: TMessage); virtual wm_first + wm_Paint;
  28.   end;
  29.  
  30.  
  31. var
  32.   hBits : hBitMap;
  33.   MDIApp: TMDIApp;
  34.  
  35. procedure TMyMDIWin.InitClientWindow;
  36. begin
  37.   ClientWnd := new(PMyMDIClient, init(@Self));
  38. end;
  39.  
  40. procedure TMyMDIClient.WMPaint(var msg: TMessage);
  41. var
  42.   hMemoryDC, TheDc: hDC;
  43.   PS: TPaintStruct;
  44.   OldObject: Thandle;
  45.   BitStruct: TBitMap;
  46.   Rect1: TRect;
  47.   Maxx, Maxy: integer;
  48.  
  49. begin
  50.   TMDIClient.wmPaint(Msg);
  51.   invalidateRect(HWindow, nil, false);
  52.   TheDC := beginPaint(HWindow, Ps);
  53.   hMemoryDC := CreateCompatibleDC(TheDC);
  54.   OldObject := selectObject(hMemoryDC, HBits);
  55.   GetObject(hbits, sizeof(TBitMap), @BitStruct);
  56.   GetClientRect(HWindow, Rect1);
  57.   maxx := Rect1.Right  - Rect1.Left;
  58.   maxy := Rect1.Bottom - Rect1.Top;
  59.   StretchBlt(TheDC, 0, 0, Maxx, Maxy, hMemoryDC,
  60.                0,0, bitstruct.bmWidth, Bitstruct.bmHeight, SRCCopy);
  61.  
  62.   SelectObject(hMemoryDC, OldObject);
  63.   DeleteDC(hMemoryDC);
  64.   Endpaint(hWindow, PS);
  65. end;
  66.  
  67. procedure TMDIApp.InitMainWindow;
  68. begin
  69.   MainWindow := New(PMyMDIWin, Init('MDI Splash Background',
  70.                     LoadMenu(HInstance, 'MDIMenu')));
  71.   hBits := LoadBitmap(hinstance, 'MDIBackground');
  72. end;
  73.  
  74. begin
  75.   MDIApp.Init('MDISplashApp');
  76.   MDIApp.Run;
  77.   MDIApp.Done;
  78. end.
  79.